home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbtool.arc / CHAPTER7.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-01  |  8.5 KB  |  434 lines
  1. {$A-}
  2. PROGRAM CHAPTER7;
  3. {$I TOOLU.PAS}
  4. var cmdptr:file;
  5. PROCEDURE FORMAT;
  6. CONST
  7.   CMD=PERIOD;
  8.   PAGENUM=SHARP;
  9.   PAGEWIDTH=60;
  10.   PAGELEN=66;
  11.   HUGE=10000;
  12. TYPE
  13.   CMDTYPE=(BP,BR,CE,FI,FO,HE,IND,LS,NF,PL,
  14.     RM,SP,TI,UL,UNKNOWN);
  15. VAR
  16.   CURPAGE,NEWPAGE,LINENO:INTEGER;
  17.   PLVAL,M1VAL,M2VAL,M3VAL,M4VAL:INTEGER;
  18.   BOTTOM:INTEGER;
  19.   HEADER,FOOTER:XSTRING;
  20.   
  21.   FILL:BOOLEAN;
  22.   LSVAL,SPVAL,INVAL,RMVAL,TIVAL,CEVAL,ULVAL:INTEGER;
  23.  
  24.   OUTP,OUTW,OUTWDS:INTEGER;
  25.   OUTBUF:XSTRING;
  26.   DIR:0..1;
  27.   INBUF:XSTRING;
  28.   
  29. PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
  30. BEGIN
  31.   WHILE(S[I]=BLANK) OR(S[I]=TAB)DO
  32.     I:=I+1
  33.   END;
  34.   
  35. FUNCTION GETVAL(VAR BUF:XSTRING;VAR ARGTYPE:INTEGER):INTEGER;
  36. VAR
  37.   I:INTEGER;
  38. BEGIN
  39.   I:=1;
  40.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  41.     I:=I+1;
  42.   SKIPBL(BUF,I);
  43.   ARGTYPE:=BUF[I];
  44.   IF(ARGTYPE=PLUS) OR (ARGTYPE=MINUS) THEN
  45.     I:=I+1;
  46.   GETVAL:=CTOI(BUF,I)
  47. END;
  48.  
  49. PROCEDURE SETPARAM(VAR PARAM:INTEGER;VAL,ARGTYPE,DEFVAL,MINVAL,MAXVAL:
  50.   INTEGER);
  51. BEGIN
  52.   IF(ARGTYPE=NEWLINE)THEN
  53.     PARAM:=DEFVAL
  54.   ELSE IF (ARGTYPE=PLUS)THEN
  55.     PARAM:=PARAM+VAL
  56.   ELSE IF(ARGTYPE=MINUS) THEN
  57.     PARAM:=PARAM-VAL
  58.   ELSE PARAM:=VAL;
  59.   PARAM:=MIN(PARAM,MAXVAL);
  60.   PARAM:=MAX(PARAM,MINVAL)
  61. END;
  62.  
  63. PROCEDURE SKIP(N:INTEGER);
  64. VAR I:INTEGER;
  65. BEGIN
  66.   FOR I:=1 TO N DO
  67.     PUTC(NEWLINE)
  68. END;
  69.  
  70. PROCEDURE PUTTL(VAR BUF:XSTRING;PAGENO:INTEGER);
  71. VAR I:INTEGER;
  72. BEGIN
  73.   FOR I:=1 TO XLENGTH(BUF) DO
  74.     IF(BUF[I]=PAGENUM) THEN
  75.       PUTDEC(PAGENO,1)
  76.     ELSE
  77.       PUTC(BUF[I])
  78. END;
  79.  
  80. PROCEDURE PUTFOOT;
  81. BEGIN
  82.   SKIP(M3VAL);
  83.   IF(M4VAL>0) THEN BEGIN
  84.     PUTTL(FOOTER,CURPAGE);
  85.     SKIP(M4VAL-1)
  86.   END
  87. END;
  88.  
  89. PROCEDURE PUTHEAD;
  90. BEGIN
  91.   CURPAGE:=NEWPAGE;
  92.   NEWPAGE:=NEWPAGE+1;
  93.   IF(M1VAL>0)THEN BEGIN
  94.     SKIP(M1VAL-1);
  95.     PUTTL(HEADER,CURPAGE)
  96.   END;
  97.   SKIP(M2VAL);
  98.   LINENO:=M1VAL+M2VAL+1
  99. END;
  100.  
  101. PROCEDURE PUT(VAR BUF:XSTRING);
  102. VAR
  103.   I:INTEGER;
  104. BEGIN
  105.   IF(LINENO<=0) OR(LINENO>BOTTOM) THEN
  106.     PUTHEAD;
  107.   FOR I:=1 TO INVAL+TIVAL DO
  108.     PUTC(BLANK);
  109.   TIVAL:=0;
  110.   PUTSTR(BUF,STDOUT);
  111.   SKIP(MIN(LSVAL-1,BOTTOM-LINENO));
  112.   LINENO:=LINENO+LSVAL;
  113.   IF(LINENO>BOTTOM)THEN PUTFOOT
  114. END;
  115.  
  116.  
  117. PROCEDURE BREAK;
  118. BEGIN
  119.   IF(OUTP>0) THEN BEGIN
  120.     OUTBUF[OUTP]:=NEWLINE;
  121.     OUTBUF[OUTP+1]:=ENDSTR;
  122.     PUT(OUTBUF)
  123.   END;
  124.   OUTP:=0;
  125.   OUTW:=0;
  126.   OUTWDS:=0
  127. END;
  128.  
  129. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  130.   VAR OUT:XSTRING):INTEGER;
  131. VAR
  132.   J:INTEGER;
  133. BEGIN
  134.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  135.     I:=I+1;
  136.   J:=1;
  137.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  138.     OUT[J]:=S[I];
  139.     I:=I+1;
  140.     J:=J+1
  141.   END;
  142.   OUT[J]:=ENDSTR;
  143.   IF(S[I]=ENDSTR) THEN
  144.     GETWORD:=0
  145.   ELSE
  146.     GETWORD:=I
  147. END;
  148.  
  149. PROCEDURE LEADBL(VAR BUF:XSTRING);
  150. VAR I,J:INTEGER;
  151. BEGIN
  152.   BREAK;
  153.   I:=1;
  154.   WHILE(BUF[I]=BLANK) DO
  155.     I:=I+1;
  156.   IF(BUF[I]<>NEWLINE) THEN
  157.     TIVAL:=TIVAL+I-1;
  158.   FOR J:=I TO XLENGTH(BUF)+1 DO
  159.     BUF[J-I+1]:=BUF[J]
  160. END;
  161.  
  162. PROCEDURE GETTL(VAR BUF,TTL:XSTRING);
  163. VAR
  164.   I:INTEGER;
  165. BEGIN
  166.   I:=1;
  167.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  168.     I:=I+1;
  169.   SKIPBL(BUF,I);
  170.   IF(BUF[I]=SQUOTE) OR(BUF[I]=DQUOTE)THEN
  171.     I:=I+1;
  172.   SCOPY(BUF,I,TTL,1)
  173. END;
  174.  
  175. PROCEDURE SPACE(N:INTEGER);
  176. BEGIN
  177.   BREAK;
  178.   IF (LINENO<=BOTTOM) THEN BEGIN
  179.     IF(LINENO<=0)THEN
  180.       PUTHEAD;
  181.     SKIP(MIN(N,BOTTOM+1-LINENO));
  182.     LINENO:=LINENO+N;
  183.     IF(LINENO>BOTTOM) THEN
  184.       PUTFOOT
  185.   END
  186. END;
  187.  
  188. PROCEDURE PAGE;
  189. BEGIN
  190.   BREAK;
  191.   IF(LINENO>0) AND (LINENO<=BOTTOM) THEN BEGIN
  192.     SKIP(BOTTOM+1-LINENO);putfoot
  193.   END;
  194.   LINENO:=0
  195. END;
  196.  
  197. FUNCTION WIDTH(VAR BUF:XSTRING):INTEGER;
  198. VAR
  199.   I,W:INTEGER;
  200. BEGIN
  201.   W:=0;
  202.   I:=1;
  203.   WHILE(BUF[I]<>ENDSTR) DO BEGIN
  204.     IF (BUF[I] = BACKSPACE) THEN
  205.       W:=W-1
  206.     ELSE IF (BUF[I]<>NEWLINE) THEN
  207.       W:=W+1;I:=I+1
  208.   END;
  209.   WIDTH:=W
  210. END;
  211.  
  212. PROCEDURE SPREAD(VAR BUF:XSTRING;
  213. OUTP,NEXTRA,OUTWDS:INTEGER);
  214. VAR
  215.   I,J,NB,NHOLES:INTEGER;
  216. BEGIN
  217.   IF(NEXTRA>0) AND (OUTWDS>1) THEN BEGIN
  218.     DIR:=1-DIR;
  219.     NHOLES:=OUTWDS-1;
  220.     I:=OUTP-1;
  221.     J:=MIN(MAXSTR-2,I+NEXTRA);
  222.     WHILE(I<J) DO BEGIN
  223.       BUF[J]:=BUF[I];
  224.       IF(BUF[I]=BLANK) THEN BEGIN
  225.         IF(DIR=0) THEN
  226.           NB:=(NEXTRA-1) DIV NHOLES +1
  227.         ELSE NB:=NEXTRA DIV NHOLES;
  228.         NEXTRA:=NEXTRA - NB;
  229.         NHOLES:=NHOLES-1;
  230.         WHILE(NB>0) DO BEGIN
  231.           J:=J-1;
  232.           BUF[J]:=BLANK;
  233.           NB:=NB-1
  234.         END
  235.       END;
  236.       I:=I-1;
  237.       J:=J-1
  238.     END
  239.   END
  240. END;
  241.  
  242. PROCEDURE PUTWORD(VAR WORDBUF:XSTRING);
  243. VAR
  244.   LAST,LLVAL,NEXTRA,W:INTEGER;
  245. BEGIN
  246.   W:=WIDTH(WORDBUF);
  247.   LAST:=XLENGTH(WORDBUF)+OUTP+1;
  248.   LLVAL:=RMVAL-TIVAL-INVAL;
  249.   IF(OUTP>0)
  250.     AND ((OUTW+W>LLVAL) OR (LAST >=MAXSTR)) THEN BEGIN
  251.       LAST:=LAST-OUTP;
  252.       NEXTRA:=LLVAL-OUTW+1;
  253.       IF(NEXTRA >0) AND(OUTWDS>1) THEN BEGIN
  254.         SPREAD(OUTBUF,OUTP,NEXTRA,OUTWDS);
  255.         OUTP:=OUTP+NEXTRA
  256.       END;
  257.       BREAK
  258.     END;
  259.     SCOPY(WORDBUF,1,OUTBUF,OUTP+1);
  260.     OUTP:=LAST;
  261.     OUTBUF[OUTP]:=BLANK;
  262.     OUTW:=OUTW+W+1;
  263.     OUTWDS:=OUTWDS+1
  264. END;
  265.  
  266. PROCEDURE CENTER(VAR BUF:XSTRING);
  267. BEGIN
  268.   TIVAL:=MAX((RMVAL+TIVAL-WIDTH(BUF)) DIV 2,0)
  269. END;
  270.  
  271. PROCEDURE UNDERLN (VAR BUF:XSTRING;SIZE:INTEGER);
  272. VAR
  273.   I,J:INTEGER;
  274.   TBUF:XSTRING;
  275. BEGIN
  276.   J:=1;
  277.   I:=1;
  278.   WHILE(BUF[I]<>NEWLINE) AND (J<SIZE-1)DO BEGIN
  279.     IF(ISALPHANUM(BUF[I])) THEN BEGIN
  280.       TBUF[J]:=UNDERLINE;
  281.       TBUF[J+1]:=BACKSPACE;
  282.       J:=J+2
  283.     END;
  284.     TBUF[J]:=BUF[I];
  285.     J:=J+1;
  286.     I:=I+1
  287.   END;
  288.   TBUF[J]:=NEWLINE;
  289.   TBUF[J+1]:=ENDSTR;
  290.   SCOPY(TBUF,1,BUF,1)
  291. END;
  292.  
  293. PROCEDURE TEXT(VAR INBUF:XSTRING);
  294. VAR
  295.   WORDBUF:XSTRING;
  296.   I:INTEGER;
  297. BEGIN
  298.   IF(INBUF[1]=BLANK) OR (INBUF[1]=NEWLINE) THEN
  299.     LEADBL(INBUF);
  300.   IF(ULVAL>0) THEN BEGIN
  301.     UNDERLN(INBUF,MAXSTR);
  302.     ULVAL:=ULVAL-1
  303.   END;
  304.   IF(CEVAL>0)THEN BEGIN
  305.     CENTER(INBUF);
  306.     PUT(INBUF);
  307.     CEVAL:=CEVAL-1
  308.   END
  309.   ELSE IF (INBUF[1]=NEWLINE)THEN
  310.     PUT(INBUF)
  311.   ELSE IF(NOT FILL) THEN
  312.     PUT(INBUF)
  313.   ELSE BEGIN
  314.     I:=1;
  315.     REPEAT
  316.       I:=GETWORD(INBUF,I,WORDBUF);
  317.       IF(I>0)THEN
  318.         PUTWORD(WORDBUF)
  319.       UNTIL(I=0)
  320.     END
  321.     
  322. END;
  323.   
  324.  
  325. PROCEDURE INITFMT;
  326. BEGIN
  327.   FILL:=TRUE;
  328.   DIR:=0;
  329.   INVAL:=0;
  330.   RMVAL:=PAGEWIDTH;
  331.   TIVAL:=0;
  332.   LSVAL:=1;
  333.   SPVAL:=0;
  334.   CEVAL:=0;
  335.   ULVAL:=0;
  336.   LINENO:=0;
  337.   CURPAGE:=0;
  338.   NEWPAGE:=1;
  339.   PLVAL:=PAGELEN;
  340.   M1VAL:=3;M2VAL:=2;M3VAL:=2;M4VAL:=3;
  341.   BOTTOM:=PLVAL-M3VAL-M4VAL;
  342.   HEADER[1]:=NEWLINE;
  343.   HEADER[2]:=ENDSTR;
  344.   FOOTER[1]:=NEWLINE;
  345.   FOOTER[2]:=ENDSTR;
  346.   OUTP:=0;
  347.   OUTW:=0;
  348.   OUTWDS:=0
  349. END;
  350.  
  351. FUNCTION GETCMD(VAR BUF:XSTRING):CMDTYPE;
  352. VAR
  353.   CMD:PACKED ARRAY[1..2] OF CHAR;
  354. BEGIN
  355.   CMD[1]:=CHR(BUF[2]);
  356.   CMD[2]:=CHR(BUF[3]);
  357.   IF(CMD='fi')THEN GETCMD:=FI
  358.   ELSE IF (CMD='nf')THEN GETCMD:=NF
  359.   ELSE IF (CMD='br')THEN GETCMD:=BR
  360.   ELSE IF (CMD='ls')THEN GETCMD:=LS
  361.   ELSE IF (CMD='bp')THEN GETCMD:=BP
  362.   ELSE IF (CMD='sp')THEN GETCMD:=SP
  363.   ELSE IF (CMD='in')THEN GETCMD:=IND
  364.   ELSE IF (CMD='rm')THEN GETCMD:=RM
  365.   ELSE IF (CMD='ce')THEN GETCMD:=CE
  366.   ELSE IF (CMD='ti')THEN GETCMD:=TI
  367.   ELSE IF (CMD='ul')THEN GETCMD:=UL
  368.   ELSE IF (CMD='he') THEN GETCMD:=HE
  369.   ELSE IF (CMD='fo') THEN GETCMD:=FO
  370.   ELSE IF (CMD='pl') THEN GETCMD:=PL
  371.   ELSE GETCMD:=UNKNOWN
  372. END;
  373.  
  374. PROCEDURE COMMAND(VAR BUF:XSTRING);
  375. VAR CMD:CMDTYPE;
  376. ARGTYPE,SPVAL,VAL:INTEGER;
  377. BEGIN
  378.   CMD:=GETCMD(BUF);
  379.   IF(CMD<>UNKNOWN)THEN
  380.     VAL:=GETVAL(BUF,ARGTYPE);
  381.     CASE CMD OF
  382.     FI:BEGIN
  383.        BREAK;
  384.        FILL:=TRUE END;
  385.     NF:BEGIN BREAK;
  386.        FILL:=FALSE END;
  387.     BR:BREAK;
  388.     LS:SETPARAM(LSVAL,VAL,ARGTYPE,1,1,HUGE);
  389.     CE:BEGIN BREAK;
  390.        SETPARAM(CEVAL,VAL,ARGTYPE,1,0,HUGE) END;
  391.     UL:SETPARAM(ULVAL,VAL,ARGTYPE,1,0,HUGE);
  392.     HE:GETTL(BUF,HEADER);
  393.     FO:GETTL(BUF,FOOTER);
  394.     BP:BEGIN PAGE;
  395.        SETPARAM(CURPAGE,VAL,ARGTYPE,CURPAGE+1,-HUGE,HUGE);
  396.        NEWPAGE:=CURPAGE END;
  397.     SP:BEGIN
  398.        SETPARAM(SPVAL,VAL,ARGTYPE,1,0,HUGE);
  399.        space(spval)
  400.        END;
  401.     IND:SETPARAM(INVAL,VAL,ARGTYPE,0,0,RMVAL-1);
  402.     RM:SETPARAM(INVAL,VAL,ARGTYPE,PAGEWIDTH,
  403.         INVAL+TIVAL+1,HUGE);
  404.     TI:BEGIN BREAK;
  405.        SETPARAM(TIVAL,VAL,ARGTYPE,0,-HUGE,RMVAL) END;
  406.     PL:BEGIN
  407.        SETPARAM(PLVAL,VAL,ARGTYPE,PAGELEN,
  408.         M1VAL+M2VAL+M3VAL+M4VAL+1,HUGE);
  409.        BOTTOM:=PLVAL-M3VAL-M4VAL END;
  410.     UNKNOWN:
  411.     END
  412.   END;
  413.  
  414.        
  415.        
  416.  
  417. BEGIN
  418.   
  419.   INITFMT;
  420.   WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO
  421.     IF(INBUF[1]=CMD) THEN
  422.       COMMAND(INBUF)
  423.     ELSE
  424.       TEXT(INBUF);
  425.     PAGE
  426. END;
  427.  
  428. BEGIN
  429.   FORMAT;
  430.   ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr)
  431. END.
  432.  
  433.  
  434.